home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2001 June
/
CHIP Haziran 2001.iso
/
prog
/
haziran
/
19
/
setup.exe
/
data.z
/
spkr_lib.bas
< prev
next >
Wrap
BASIC Source File
|
2001-04-11
|
5KB
|
143 lines
Attribute VB_Name = "spkr_lib"
'////////////////////////////////////////////////////////////////
'// File - spkr_lib.bas
'//
'// This application plays a tone to the speaker, and is
'// controlled via a graphical user interface - skprGUI.frm
'// The speaker is accessed directly on the motherboard, using
'// WinDriver functions.
'//
'////////////////////////////////////////////////////////////////
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const SPEAKER_IO_42 = 0
Const SPEAKER_IO_43 = 1
Const SPEAKER_IO_61 = 2
Const SPEAKER_ITEMS = 3
Const SPEAKER_IO_ADDR42 = &H42
Const SPEAKER_IO_ADDR43 = &H43
Const SPEAKER_IO_ADDR61 = &H61
Const bit0 As Long = &H1
Const bit1 As Long = &H2
Type SPEAKER_HANDLE
hWD As Long
cardReg As WD_CARD_REGISTER
End Type
'this string is set to an error message, if one occurs
Public SPEAKER_ErrorString As String
Sub SPEAKER_SetCardElements(hSPEAKER As SPEAKER_HANDLE)
' internal function used by SPEAKER_Open()
hSPEAKER.cardReg.Card.dwItems = SPEAKER_ITEMS
' SPEAKER IO range
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_42).Item = ITEM_IO
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_42).fNotSharable = False
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_42).dw1 = SPEAKER_IO_ADDR42
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_42).dw2 = 1
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_43).Item = ITEM_IO
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_43).fNotSharable = False
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_43).dw1 = SPEAKER_IO_ADDR43
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_43).dw2 = 1
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_61).Item = ITEM_IO
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_61).fNotSharable = False
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_61).dw1 = SPEAKER_IO_ADDR61
hSPEAKER.cardReg.Card.Item(SPEAKER_IO_61).dw2 = 1
End Sub
Function SPEAKER_Open(hSPEAKER As SPEAKER_HANDLE) As Boolean
Dim ver As WD_VERSION
hSPEAKER.cardReg.hCard = 0
hSPEAKER.hWD = INVALID_HANDLE_VALUE
hSPEAKER.hWD = WD_Open()
If hSPEAKER.hWD = INVALID_HANDLE_VALUE Then
SPEAKER_ErrorString = "ERROR - Cannot open WinDriver device"
GoTo Error
End If
' check if handle valid & version OK
WD_Version hSPEAKER.hWD, ver
If ver.dwVer < WD_VER Then
SPEAKER_ErrorString = "ERROR - incorrect WinDriver version"
GoTo Error
End If
SPEAKER_SetCardElements hSPEAKER
hSPEAKER.cardReg.fCheckLockOnly = False
WD_CardRegister hSPEAKER.hWD, hSPEAKER.cardReg
If (hSPEAKER.cardReg.hCard = 0) Then
SPEAKER_ErrorString = "ERROR - could not lock device"
GoTo Error
End If
'open finished OK
SPEAKER_Open = True
GoTo finish
Error:
'error during open
If (hSPEAKER.cardReg.hCard <> 0) Then
WD_CardUnregister hSPEAKER.hWD, hSPEAKER.cardReg
End If
If (hSPEAKER.hWD <> INVALID_HANDLE_VALUE) Then
WD_Close hSPEAKER.hWD
End If
SPEAKER_Open = False
finish:
End Function
Sub SPEAKER_Close(hSPEAKER As SPEAKER_HANDLE)
' unregister card
If (hSPEAKER.cardReg.hCard <> 0) Then
WD_CardUnregister hSPEAKER.hWD, hSPEAKER.cardReg
End If
' close WinDriver
WD_Close (hSPEAKER.hWD)
End Sub
Sub SPEAKER_WriteCtrl(hSPEAKER As SPEAKER_HANDLE, data As Byte)
Dim trans As WD_TRANSFER
trans.cmdTrans = WP_BYTE
trans.dwPort = SPEAKER_IO_ADDR61
trans.dwDataTransfer = data
WD_Transfer hSPEAKER.hWD, trans
End Sub
Function SPEAKER_ReadCtrl(hSPEAKER As SPEAKER_HANDLE) As Byte
Dim trans As WD_TRANSFER
trans.cmdTrans = RP_BYTE
trans.dwPort = SPEAKER_IO_ADDR61
WD_Transfer hSPEAKER.hWD, trans
SPEAKER_ReadCtrl = trans.dwDataTransfer
End Function
Sub SPEAKER_WriteTimerData(hSPEAKER As SPEAKER_HANDLE, data As Byte)
Dim trans As WD_TRANSFER
trans.cmdTrans = WP_BYTE
trans.dwPort = SPEAKER_IO_ADDR42
trans.dwDataTransfer = data
WD_Transfer hSPEAKER.hWD, trans
End Sub
Sub SPEAKER_WriteTimerCtrl(hSPEAKER As SPEAKER_HANDLE, data As Byte)
Dim trans As WD_TRANSFER
trans.cmdTrans = WP_BYTE
trans.dwPort = SPEAKER_IO_ADDR43
trans.dwDataTransfer = data
WD_Transfer hSPEAKER.hWD, trans
End Sub
Sub SPEAKER_Tone(hSPEAKER As SPEAKER_HANDLE, dwHz As Long, dwMilli As Long)
Dim dwDevisor As Long
Dim bCtrl As Byte
dwDevisor = 1190000 \ dwHz
SPEAKER_WriteTimerCtrl hSPEAKER, &HB6
SPEAKER_WriteTimerData hSPEAKER, dwDevisor And &HFF
SPEAKER_WriteTimerData hSPEAKER, ((dwDevisor \ 2 ^ 8) And &HFF)
bCtrl = SPEAKER_ReadCtrl(hSPEAKER)
SPEAKER_WriteCtrl hSPEAKER, bCtrl Or (bit0 Or bit1)
Sleep (dwMilli)
SPEAKER_WriteCtrl hSPEAKER, bCtrl And Not (bit0 Or bit1)
End Sub